home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbasicpg.zip / SHAPES.BAS < prev    next >
BASIC Source File  |  1989-08-31  |  4KB  |  125 lines
  1. ' SHAPES.BAS
  2. ' This program displays a shape filled with your favorite character.
  3.  
  4. ' declare constants used as arguments to the COLOR statement
  5.  
  6. CONST CYAN% = 3
  7. CONST WHITE% = 7
  8.  
  9. ' declare subprograms before they are used; subprogram names and
  10. '   parameters should match those in the subprograms
  11.  
  12. DECLARE SUB GetShape (symbol$, choice%)
  13. DECLARE SUB PrintLine (char$)
  14. DECLARE SUB PrintRectangle (char$)
  15. DECLARE SUB PrintTriangle (char$)
  16.    
  17. CLS
  18.  
  19. ' call GetShape subprogram to get desired character and shape
  20.  
  21. GetShape character$, shape%   ' pass two arguments to GetShape
  22.  
  23. PRINT
  24. PRINT
  25. COLOR CYAN%
  26.  
  27. ' use CASE statement to call the requested subprogram
  28.  
  29. SELECT CASE shape%
  30.     CASE 1          ' if shape% = 1, display a triangle
  31.         PrintTriangle character$
  32.     CASE 2          ' if shape% = 2, display a rectangle
  33.         PrintRectangle character$
  34.     CASE 3          ' if shape% = 3, display a line
  35.         PrintLine character$
  36. END SELECT
  37.  
  38. COLOR WHITE%
  39.  
  40. END
  41.  
  42. SUB GetShape (symbol$, choice%)
  43.  
  44. ' The GetShape subprogram prompts the user for a symbol and a shape
  45. '   and returns them to the main program in the symbol$ and choice%
  46. '   variables.
  47.  
  48. PRINT "This program prints a collection of characters in the ";
  49. PRINT "shape you specify."
  50. PRINT
  51. INPUT "What character would you like to use:  ", symbol$
  52. PRINT
  53. PRINT "What shape would you like to see:"
  54. PRINT
  55. PRINT "    1) Triangle"
  56. PRINT "    2) Rectangle"
  57. PRINT "    3) Line"
  58. PRINT
  59.    
  60. DO        ' prompt the user until choice% is in the right range
  61.     INPUT "Shape (1, 2, or 3):  ", choice%
  62. LOOP WHILE (choice% < 1) OR (choice% > 3)
  63.  
  64. END SUB   ' subprogram complete--return to the main program
  65.  
  66. SUB PrintLine (char$)
  67.  
  68. ' The PrintLine subprogram receives an argument from the main
  69. '   program and uses it to print a line 30 characters long.
  70.  
  71. CONST LENGTH% = 30     ' set the length of the line at 30 characters
  72.  
  73. FOR i% = 1 TO LENGTH%  ' display the character 30 times
  74.     PRINT char$;       ' use semicolon to print them one after another
  75. NEXT i%
  76.  
  77. PRINT
  78.  
  79. END SUB
  80.  
  81. SUB PrintRectangle (char$)
  82.  
  83. ' The PrintRectangle subprogram receives an argument from the main
  84. '   program and uses it to print a rectangle 50 characters long by
  85. '   7 characters high.
  86.  
  87. CONST LENGTH% = 50         ' set length of rectangle at 50 rows
  88. CONST HEIGHT% = 7          ' set height of rectangle at 7 lines
  89.  
  90. FOR i% = 1 TO HEIGHT%      ' for each of the 7 rows in the rectangle,
  91.     FOR j% = 1 TO LENGTH%  '   display 50 characters one after another
  92.         PRINT char$;
  93.     NEXT j%
  94.     PRINT                  ' print a carriage return after each row
  95. NEXT i%
  96.  
  97. END SUB
  98.  
  99. SUB PrintTriangle (char$)
  100.  
  101. ' The PrintTriangle subprogram receives an argument from the main
  102. '   program and uses it to print an equilateral triangle.  The Tab
  103. '   function moves the cursor to the correct column location.
  104.  
  105. CONST ROWS% = 10     ' set the number of rows to 10
  106. left% = ROWS%        ' use left% to build left side of triangle
  107. right% = ROWS% + 1   ' use right% to build right side of triangle
  108.  
  109. FOR rowCount% = 1 TO ROWS%             ' for each row in the triangle
  110.     FOR i% = left% TO ROWS%
  111.         PRINT TAB(i%); char$;          ' display left side of row
  112.     NEXT i%
  113.  
  114.     FOR i% = ROWS% + 1 TO right% - 1   ' display right side of row
  115.         PRINT TAB(i%); char$;
  116.     NEXT i%
  117.  
  118.     PRINT                 ' print carriage return at end of row
  119.     left% = left% - 1     ' first character in next row will start one
  120.     right% = right% + 1   '   space closer to left margin and extend
  121. NEXT rowCount%            '   one space closer to the right margin
  122.  
  123. END SUB
  124.  
  125.